Sky at Night 2006 September/SAN CD 9-2006 CD-ROM 16.iso/pc/Software/Network Telescope Control/NTC-Setup.Exe/Source/ntc_ciel_client_object.pas

Pascal/Delphi Source File | 2006-03-24 | 11.6 KB | 675 lines

unit ntc_ciel_client_object;
{
    Copyright (C) 2004 - 2006 Andrew Sprott

    http://astronomy.crysania.co.uk
    [e-mail]

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

interface

uses
    SysUtils;

const
    no_value=999;

type
    hms=record
        hours,
        minutes,
        seconds,
        tens:integer;
        high,
        low:string;
    end;

    dms=record
        degrees,
        minutes,
        seconds,
        tens:integer;
        high,
        low:string;
    end;

    ams=record
        degrees,
        minutes,
        seconds,
        tens:integer;
        high,
        low:string;
    end;

    tscope_object=class(tobject)

        constructor create;

    private
        { private declarations }
    public
        { Public declarations }
        name:string;
        magnitude,
        magnification:integer;
        high_precision:boolean;
        { parameters to control scope }
        ra,
        dec:double;
        alt,
        az:double;
        speed,
        dir:string[16];
        info:string;
        { debug }
        input:string;
        { end debug }

        { binary to text }
        procedure right_ascension_str(
                    h,m,s:integer;
            var ra_rec:hms); overload;

        procedure right_ascension_str(
                    f:double;
            var ra_rec:hms); overload;

        procedure declination_str(
                    d,m,s:integer;
            var dec_rec:dms); overload;

        procedure declination_str(
                    f:double;
            var dec_rec:dms); overload;

        procedure azimuth_str(
                    f:double;
            var az_rec:dms); overload;

        procedure altitude_str(
                    f:double;
            var alt_rec:ams); overload;

        procedure right_ascension_str(
            var ra_rec:hms); overload;

        procedure declination_str(
            var dec_rec:dms); overload;

        procedure azimuth_str(
            var az_rec:dms); overload;

        procedure altitude_str(
            var alt_rec:ams); overload;

        { text to binary }
        function str_right_ascension(
            var f:double;
            var ra_rec:hms)
                    :boolean; overload;

        function str_declination(
            var f:double;
            var dec_rec:dms)
                    :boolean; overload;

        function str_azimuth(
            var f:double;
            var az_rec:dms)
                    :boolean; overload;

        function str_altitude(
            var f:double;
            var alt_rec:ams)
                    :boolean; overload;

        function str_right_ascension(
            var ra_rec:hms)
                    :boolean; overload;

        function str_declination(
            var dec_rec:dms)
                    :boolean; overload;

        function str_azimuth(
            var az_rec:dms)
                    :boolean; overload;

        function str_altitude(
            var alt_rec:ams)
                    :boolean; overload;

    end;

var
    current_object:tscope_object;

implementation

uses
    ntc_ciel_client_form;

    { -------------
        form handling
        ------------- }

constructor tscope_object.create;
begin
    name:='';
    ra:=4.7;
    dec:=51.5;
    alt:=51.38;
    az:=4.08;
    magnitude:=1;
    magnification:=1;
    high_precision:=true;
end;

procedure sinc(
    var s:string;
            t:string);
begin
    s:=s+t;
end;

    { --------------
        binary to text
        -------------- }

{ HH:MM:SS
    HH:MM.T }
procedure tscope_object.right_ascension_str(
            h,m,s:integer;
    var ra_rec:hms);
begin
    with ra_rec do
        begin
            hours:=h;
            seconds:=s;
            minutes:=m;
            tens:=seconds div 10;
            high:='';
            if hours<10 then
                high:='0';
            sinc(high,inttostr(hours)+':');
            if minutes<10 then
                sinc(high,'0');
            sinc(high,inttostr(minutes));
            sinc(high,':');
            low:=high;
            if seconds<10 then
                sinc(high,'0');
            sinc(high,inttostr(seconds));
            sinc(low,'.'+inttostr(seconds div 10));
        end;
end;

{ HH:MM:SS
    HH:MM.T }
procedure tscope_object.right_ascension_str(
            f:double;
    var ra_rec:hms);
var
    m:double;
begin
    ra:=f;
    with ra_rec do
        begin
            hours:=trunc(f);
            m:=frac(f)*60;
            seconds:=trunc(frac(m)*60);
            minutes:=trunc(m);
            right_ascension_str(hours,minutes,seconds,ra_rec);
        end;
end;

{ sDDflMM:SS
    sDDflMM }
procedure tscope_object.declination_str(
            d,m,s:integer;
    var dec_rec:dms);
begin
    with dec_rec do
        begin
            degrees:=d;
            seconds:=s;
            minutes:=m;
            tens:=seconds div 10;
            if degrees<0 then
                high:='-'
            else
                high:='+';
            if degrees<10 then
                sinc(high,'0');
            sinc(high,inttostr(degrees)+'fl');
            if minutes<10 then
                sinc(high,'0');
            sinc(high,inttostr(minutes));
            low:=high;
            sinc(high,':');
            if seconds<10 then
                sinc(high,'0');
            sinc(high,inttostr(seconds));
        end;
end;

{ sDDflMM:SS
    sDDflMM }
procedure tscope_object.declination_str(
            f:double;
    var dec_rec:dms);
var
    m:double;
begin
    dec:=f;
    with dec_rec do
        begin
            degrees:=trunc(f);
            m:=abs(frac(f)*60);
            seconds:=trunc(frac(m)*60);
            minutes:=trunc(m);
            declination_str(degrees,minutes,seconds,dec_rec);
        end;
end;

{ DDDflMM:SS
    DDDflMM.T }
procedure tscope_object.azimuth_str(
            f:double;
    var az_rec:dms);
var
    m:double;
begin
    az:=f;
    with az_rec do
        begin
            degrees:=trunc(f);
            m:=frac(f)*60;
            seconds:=trunc(frac(m)*60);
            minutes:=trunc(m);
            tens:=seconds div 10;
            if degrees<10 then
                high:='0'
            else
                high:='';
            sinc(high,inttostr(degrees)+'fl');
            if minutes<10 then
                sinc(high,'0');
            sinc(high,inttostr(minutes));
            low:=high+'.'+inttostr(tens);
            sinc(high,':');
            if seconds<10 then
                sinc(high,'0');
            sinc(high,inttostr(seconds));
        end;
end;

{ sDDflMM:SS
    sDDflMM }
procedure tscope_object.altitude_str(
            f:double;
    var alt_rec:ams);
var
    t_dec:double;
begin
    t_dec:=dec;
    alt:=f;
    declination_str(f,dms(alt_rec));
    dec:=t_dec;
end;

procedure tscope_object.right_ascension_str(
    var ra_rec:hms);
begin
    right_ascension_str(ra,ra_rec);
end;

procedure tscope_object.declination_str(
    var dec_rec:dms);
begin
    declination_str(dec,dec_rec);
end;

procedure tscope_object.azimuth_str(
    var az_rec:dms);
begin
    azimuth_str(az,az_rec);
end;

procedure tscope_object.altitude_str(
    var alt_rec:ams);
begin
    altitude_str(alt,alt_rec);
end;

    { --------------
        text to binary
        -------------- }

{ HH:MM:SS
    HH:MM.T }
function tscope_object.str_right_ascension(
    var f:double;
    var ra_rec:hms)
            :boolean;
var
    s,r:string;
    i:integer;
    h,n:boolean;
begin
    result:=false;
    with ra_rec do
        begin
            if high<>'' then
                r:=high
            else
                r:=low;
            input:=r;
            while r[length(r)]='#' do
                r:=copy(r,1,length(r)-1);
            i:=pos(':',r);
            if i=0 then
                exit;
            s:=copy(r,1,i-1);
            hours:=strtointdef(s,no_value);
            if hours=no_value then
                exit;
            r:=copy(r,i+1,length(r)-i);
            i:=pos(':',r);
            if i=0 then
                begin
                    i:=pos('.',r);
                    h:=false;
                    if i=0 then
                        begin
                            i:=length(r)+1;
                            n:=true;
                        end
                    else
                        begin
                            low:=high;
                            n:=false;
                        end;
                end
            else
                begin
                    low:='';
                    h:=true;
                    n:=false;
                end;
            s:=copy(r,1,i-1);
            minutes:=strtointdef(s,no_value);
            if minutes=no_value then
                exit;
            if n then
                begin
                    tens:=0;
                    seconds:=0;
                end
            else
                begin
                    r:=copy(r,i+1,length(r)-i);
                    if not h then
                        begin
                            tens:=strtointdef(r,no_value);
                            if tens=no_value then
                                exit;
                            seconds:=tens*10;
                        end
                    else
                        begin
                            seconds:=strtointdef(r,no_value);
                            if seconds=no_value then
                                exit;
                            tens:=seconds div 10;
                        end;
                end;
            f:=seconds/60;
            f:=(f+minutes)/60;
            f:=f+hours;
        end;
    ra:=f;
    result:=true;
end;

{ sDDflMM:SS
    sDDflMM }
function tscope_object.str_declination(
    var f:double;
    var dec_rec:dms)
            :boolean;
var
    s:string;
    i,j:integer;
    r:string;
begin
    result:=false;
    with dec_rec do
        begin
            if high<>'' then
                r:=high
            else
                r:=low;
            input:=r;
            while r[length(r)]='#' do
                r:=copy(r,1,length(r)-1);
            i:=pos('fl',r);
            if i=0 then
                exit;
            j:=pos(':',r);
            if j>0 then
                low:=''
            else
                low:=high;
            s:=copy(r,1,i-1);
            degrees:=strtointdef(s,no_value);
            if degrees=no_value then
                exit;
            s:=copy(r,i+1,j-i-1);
            minutes:=strtointdef(s,no_value);
            if minutes=no_value then
                exit;
            if j>0 then
                begin
                    s:=copy(r,j+1,length(r)-j);
                    seconds:=strtointdef(s,no_value);
                    if seconds=no_value then
                        exit;
                    tens:=seconds div 10;
                end
            else
                begin
                    tens:=0;
                    seconds:=0;
                end;
            f:=seconds/60;
            f:=(f+minutes)/60;
            f:=f+degrees;
        end;
    dec:=f;
    result:=true;
end;

{ DDDMM:SS
    DDDflMM.T }
function tscope_object.str_azimuth(
    var f:double;
    var az_rec:dms)
            :boolean;
var
    s,r:string;
    t,u:char;
    i,j:integer;
    h,n:boolean;

    procedure bug;
    begin
        if copy(s,1,1)='0' then
            s:=copy(s,2,length(s)-1);
        if length(s)>1 then
            begin
                t:=s[1];
                u:=s[2];
            end
        else if length(s)>0 then
            begin
                t:='0';
                u:=s[1];
            end
        else
            begin
                az_rec.degrees:=0;
                exit;
            end;
        j:=(ord(t)-ord('0'))*10;
        az_rec.degrees:=ord(u)-ord('0')+j;
    end;

begin
    result:=false;
    with az_rec do
        begin
            if high<>'' then
                r:=high
            else
                r:=low;
            input:=r;
            while r[length(r)]='#' do
                r:=copy(r,1,length(r)-1);
            if pos('.',high)>0 then
                low:=high
            else
                low:='';
            i:=pos('fl',r);
            if i=0 then
                exit;
            s:=copy(r,1,i-1);
            if (strtointdef(s,no_value)=no_value) then
                bug
            else
                begin
                    degrees:=strtointdef(s,no_value);
                    if degrees=no_value then
                        exit;
                end;
            r:=copy(r,i+1,length(r)-i);
            i:=pos(':',r);
            if i=0 then
                begin
                    i:=pos('.',r);
                    h:=false;
                    if i=0 then
                        begin
                            i:=length(r)+1;
                            n:=true;
                        end
                    else
                        begin
                            low:=high;
                            n:=false;
                        end;
                end
            else
                begin
                    low:='';
                    h:=true;
                    n:=false;
                end;
            s:=copy(r,1,i-1);
            minutes:=strtointdef(s,no_value);
            if minutes=no_value then
                exit;
            if n then
                begin
                    tens:=0;
                    seconds:=0;
                end
            else
                begin
                    r:=copy(r,i+1,length(r)-i);
                    if not h then
                        begin
                            tens:=strtointdef(r,no_value);
                            if tens=no_value then
                                exit;
                            seconds:=tens*10;
                        end
                    else
                        begin
                            seconds:=strtointdef(r,no_value);
                            if seconds=no_value then
                                exit;
                            tens:=seconds div 10;
                        end;
                end;
            f:=seconds/60;
            f:=(f+minutes)/60;
            f:=f+degrees;
        end;
    az:=f;
    result:=true;
end;

{ sDDflMM:SS
    sDDflMM }
function tscope_object.str_altitude(
    var f:double;
    var alt_rec:ams)
            :boolean;
var
    t_dec:double;
begin
    t_dec:=dec;
    result:=str_declination(f,dms(alt_rec));
    alt:=f;
    dec:=t_dec;
end;

function tscope_object.str_right_ascension(
    var ra_rec:hms)
            :boolean;
begin
    result:=str_right_ascension(ra,ra_rec);
end;

function tscope_object.str_declination(
    var dec_rec:dms)
            :boolean;
begin
    result:=str_declination(dec,dec_rec);
end;

function tscope_object.str_azimuth(
    var az_rec:dms)
            :boolean;
begin
    result:=str_azimuth(az,az_rec);
end;

function tscope_object.str_altitude(
    var alt_rec:ams)
            :boolean;
begin
    result:=str_altitude(alt,alt_rec);
end;

begin
    current_object:=nil;
    current_object:=tscope_object.create;
end.